home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / makearr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-20  |  2.1 KB  |  82 lines
  1.  
  2. program MakeArrayFromBintable;
  3. { Convert binairy file to Pascal array (old version), by you-know-who... }
  4. uses
  5.   crt,dos;
  6.  
  7. var
  8.   InFile : file of byte;
  9.   OutFile : text;
  10.   FileName : pathstr;
  11.   I,Size,TotalSize : longint;
  12.   J,reps : word;
  13.   InByte,repbyte,Len : byte;
  14.  
  15. function ValLen(Num : byte) : byte; begin
  16.   if Num <> 0 then ValLen := round(ln(Num)/2.303)+1 else ValLen := 1; end;
  17.  
  18. begin
  19.   writeln;
  20.   if paramstr(1) = '' then begin
  21.     write('Enter Filename: ');
  22.     readln(FileName);
  23.   end else FileName := paramstr(1);
  24.  
  25.   assign(InFile,FileName);
  26.   reset(InFile);
  27.   seek(InFile,$20); { <-- Put filepointer after mess-header! }
  28.   Size := filesize(InFile);
  29.   assign(OutFile,'ARRAY.INC');
  30.   rewrite(OutFile);
  31.   writeln(OutFile,'  PicArray : array[0..TotalSize] of byte = (');
  32.   write(OutFile,'    ');
  33.   TotalSize := 0; I := 0; Len := 4;
  34.   while not eof(InFile) do begin
  35.     read(InFile,InByte);
  36.     repbyte := inbyte;
  37.  
  38.     reps := 0;
  39.     while (inbyte = repbyte) and (not eof(infile)) do begin
  40.       read(infile,inbyte);
  41.       inc(reps);
  42.     end;
  43.  
  44.     if reps = 1 then begin
  45.       if repbyte = 0 then begin
  46.         write(outfile,0,',',0,',',1,',',0,',');
  47.         write(outfile,inbyte,',');
  48.         inc(totalsize,5);
  49.       end
  50.       else if inbyte = 0 then begin
  51.         write(outfile,repbyte,',');
  52.         write(outfile,0,',',0,',',1,',',0,',');
  53.         inc(totalsize,5);
  54.       end
  55.       else begin
  56.         write(OutFile,repbyte,',',inbyte,',');
  57.         inc(Len,ValLen(repbyte)+ValLen(inbyte)+2);
  58.         inc(TotalSize,2);
  59.       end;
  60.       inc(i,2);
  61.     end
  62.     else if reps > 1 then begin
  63.       write(outfile,0,',');
  64.       write(outfile,repbyte,',');
  65.       write(outfile,lo(reps),',',hi(reps),',');
  66.       inc(totalsize,4);
  67.       inc(i,reps-1);
  68.     end;
  69.     if Len > 75 then begin
  70.       writeln(OutFile);
  71.       write(OutFile,'    ');
  72.       Len := 4;
  73.     end;
  74.     inc(i); write(#13,size-i:6,reps:5);
  75.   end;
  76.   writeln(OutFile,');');
  77.   writeln(OutFile);
  78.   writeln(OutFile,'  TotalSize = ',TotalSize-1,';');
  79.   close(InFile); close(OutFile);
  80.   writeln;
  81. end.
  82.